home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / dvidis / vaxinate.for < prev   
Text File  |  1990-10-01  |  2KB  |  88 lines
  1.  
  2.     PROGRAM DVIDIS_VAXINATE
  3.     IMPLICIT INTEGER (A-Z)
  4.  
  5. C --- this program converts a DCL-like command to a horrid un*xy command line
  6. C --- and exits with LIB$DO_COMMAND to execute this DVIDIS command.
  7.  
  8.     CHARACTER*132 COMMAND, FILENM, PAGES
  9.     CHARACTER*10 LEFT, UPPER, COMPRAT, PAPER*16
  10.  
  11.     EXTERNAL CLI$_ABSENT, CLI$_PRESENT, CLI$_NEGATED
  12.  
  13.     ISTAT = CLI$GET_VALUE('P1', FILENM, LFILENM)
  14.     IF( .NOT.ISTAT) CALL EXIT(ISTAT)
  15.     COMMAND = FILENM
  16.  
  17.     ISTAT = CLI$GET_VALUE('PAPER', PAPER, LPAPER)
  18.     IF( ISTAT) COMMAND = '-s '//PAPER(:LPAPER)//' '//COMMAND
  19.  
  20.     ISTAT = CLI$PRESENT('COMPRESS')
  21.     IF(ISTAT .EQ. %LOC(CLI$_NEGATED) ) THEN
  22.       COMMAND = '-c ' // COMMAND
  23.     ELSE IF ( ISTAT .EQ. %LOC(CLI$_PRESENT) ) THEN
  24.         COMMAND = '-w ' // COMMAND
  25.     ENDIF
  26.  
  27.     IF ( CLI$PRESENT('VERBOSE')) COMMAND = '-verbose '//COMMAND
  28.     IF ( CLI$PRESENT('DEBUG'  )) COMMAND = '-d '//COMMAND
  29.     IF ( CLI$PRESENT('SMALL_FONTS')) COMMAND = '-m '//COMMAND
  30.  
  31. 10    ISTAT = CLI$GET_VALUE('PAGES', PAGES, LPAG)
  32.     IF( .NOT.ISTAT) GOTO 20
  33.     N = INDEX( PAGES, ':')
  34.     IF( N .EQ. 1) THEN
  35.       N = 2
  36.       PAGES = '1'//PAGES
  37.       LPAG = LPAG + 1
  38.     ELSE IF (N .EQ. LPAG) THEN
  39.       PAGES(LPAG+1:) = '99999'    ! n: means to end of file
  40.       LPAG = LPAG  + 5
  41.     ENDIF
  42.     IF( N .NE. 0) THEN
  43.       PAGES(N:N) = ' '
  44.       COMMAND = '-p '//PAGES(:LPAG)//' '//COMMAND
  45.     ELSE
  46.       COMMAND = '-p '//PAGES(:LPAG)//' '//PAGES(:LPAG)//' '//COMMAND
  47.     ENDIF
  48.     GOTO 10
  49. 20    CONTINUE
  50.  
  51.     ISTAT = CLI$GET_VALUE('UPPER_MARGIN', UPPER, LUP)
  52.     IF( ISTAT) THEN
  53.       CALL FRAC_TO_MILLIS( UPPER, LUP)
  54.       COMMAND = '-v '//UPPER(:LUP)//' '//COMMAND
  55.     ENDIF
  56.  
  57.     ISTAT = CLI$GET_VALUE('LEFT_MARGIN', LEFT, LLFT)
  58.     IF( ISTAT) THEN
  59.       CALL FRAC_TO_MILLIS( LEFT, LLFT)
  60.       COMMAND = '-h '//LEFT(:LLFT)//' '//COMMAND
  61.     ENDIF
  62.  
  63.     COMMAND = 'DODVIDIS '//COMMAND
  64.     CALL LIB$DO_COMMAND( COMMAND)
  65.  
  66.     STOP
  67.     END
  68.  
  69.     SUBROUTINE FRAC_TO_MILLIS( FRAC, LFRAC)
  70.     CHARACTER *(*) FRAC
  71.  
  72.     FRAC(LFRAC+1 :) = '000'      !need zero-pad to milli-inches
  73.     N = INDEX( FRAC, '.')
  74.     IF( N .EQ. 0) THEN
  75.       LFRAC = LFRAC + 3
  76.     ELSE 
  77.       FRAC(N:) = FRAC(N+1:)  !squat decimal point
  78.       LFRAC = N + 2            !include decimal places
  79.     ENDIF
  80.  
  81.     RETURN
  82.     END
  83.      
  84.  
  85.                 
  86.       
  87.     
  88.